home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 016 / tdsnap2.arc / TDSNAP2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-03-28  |  9.9 KB  |  383 lines
  1. {$C-}
  2. Program TDSnap;
  3. {       TDSNAP modified by
  4.           Gerald Lewis
  5.           Logic Development Corporation
  6.           127 Gaither Drive Suite F
  7.           Mt. Laurel, New Jersey 08054-1707
  8.           (609) 778-9077
  9.          This version is invoked as
  10.           TDSNAP               - output to TDSNAP.TXT
  11.           TDSNAP filename.ext  - output to filename.ext
  12.           TDSNAP filename      - output to filename.nnn
  13.                                   where nnn increments each frame
  14.          The last two invokations can be accompanied by either:
  15.            /G to include graphics
  16.            /C to include graphics but convert box characters
  17.                to acceptable WordStar characters
  18.            If neither switch is present, all graphic characters
  19.             are suppressed (converted to spaces).
  20. }
  21. const
  22.  Our_Char = 103;
  23.  Quit_Key = 119;
  24.  {User_Int = $67;}   {changed Int}
  25.  User_Int = $65;
  26.  Kybrd_Int = $16;
  27. Type
  28.  Regtype = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer end;
  29.  HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte end;
  30. Const
  31.  Regs : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  32.  OurDseg : integer = 0;
  33.  OurSseg : integer = 0;
  34.  DosSseg : integer = 0;
  35.  Inuse : Boolean = false;
  36.  User_IntIP : integer = 0;
  37.  User_IntCs : integer = 0;
  38. Var
  39.  SaveRegs : regtype;
  40.  HalfRegs : halfregtype absolute regs;
  41.  Terminate_flag : boolean ;
  42.  Keychr : char ;
  43. (*========================= Begin User Variables ===========================*)
  44.  
  45. Type
  46.    String80   = String[80];
  47.    ImageType  = Array [1..4000] of char;
  48. Const
  49.    NameOut : String[80] = 'TDSNAP.TXT';
  50.    VideoEnable = $08;                  { Video Signal Enable Bit        }
  51. Var
  52.    CGAScreen       : ImageType absolute $B800:0000;
  53.    MonoScreen      : ImageType absolute $B000:0000;
  54.    SaveScreen      : ImageType;
  55.    FileOut         : Text;             { Output text file               }
  56.    LineOut         : String[80];       { Output text line               }
  57.    NonSpace        : Byte;             { Index of last non-space        }
  58.    RIx             : Byte;             { Row Index into screen          }
  59.    CIx             : Byte;             { Col Index into screen          }
  60.    Video_Buffer    : Integer;
  61.  
  62.    Crtmode     :byte      absolute $0040:$0049;
  63.    Crtwidth    :byte      absolute $0040:$004A;
  64.    CrtAdapter  :integer   absolute $0040:$0063; { Current Display Adapter }
  65.    VideoMode   :byte      absolute $0040:$0065; { Video Port Mode byte    }
  66.  
  67.    ExtDot : byte;
  68.    ExtNum : integer;
  69.    ExtChr : string[3];
  70.    ExtNam : string[80];
  71.    GphChr : boolean;
  72.    GphCon : boolean;
  73.  
  74. (*========================== End User Variables ============================*)
  75. {---------------------------------- Exist -------------------------------------}
  76. {                                                                              }
  77. {   Given a file name, this function returns true if the file exists           }
  78. {                                                                              }
  79. Function Exist(FileName: String80): boolean;
  80. Var FileVar: file;
  81. Begin
  82.    {$I-}
  83.    Assign(FileVar,FileName);
  84.    Reset(FileVar);
  85.    If IOResult = 0 then
  86.       Exist := true
  87.    else
  88.       Exist := false;
  89.    Close(FileVar);
  90.    {$I+}
  91. End;
  92.  
  93. Procedure Stay_Xit;
  94. Begin
  95.  Writeln ('TDSnap Returning memory to DOS') ;
  96.  SaveRegs.Ax := $35 shl 8 + User_Int;
  97.  MsDos(SaveRegs);
  98.  SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  99.  SaveRegs.Ds := SaveRegs.Es;
  100.  SaveRegs.Dx := SaveRegs.Bx;
  101.  MsDos(SaveRegs);
  102.  MemW[$00:User_Int * 4] := 0 ;
  103.  MemW[$00:User_Int * 4 + 2] :=0;
  104.  Saveregs.Ax := $49 shl 8 + 0 ;
  105.  Saveregs.Es := MemW[Cseg:$2C] ;
  106.  MsDos( Saveregs ) ;
  107.  Saveregs.Ax := $49 shl 8 + 0 ;
  108.  Saveregs.Es := Cseg ;
  109.  MsDos( Saveregs ) ;
  110.  Intr($20,Regs) ;
  111. End;
  112. Procedure Process_Intr;
  113. Begin
  114.  Inline (
  115.  $80/$FC/$00/
  116.  $74/$07/
  117.  $5D/$5D/
  118.  $2E/
  119.  $FF/$2E/User_IntIP/
  120.  $FA /
  121.  $55/
  122.  $BD/Regs/
  123.  $2E/$89/$46/$00/
  124.  $2E/$89/$5E/$02/
  125.  $2E/$89/$4E/$04/
  126.  $2E/$89/$56/$06/
  127.  $2E/$8F/$46/$08/
  128.  $2E/$89/$76/$0A/
  129.  $2E/$89/$7E/$0C/
  130.  $2E/$8C/$5E/$0E/
  131.  $2E/$8C/$46/$10/
  132.  $9C/
  133.  $2E/$8F/$46/$12/
  134.  $2E/$80/$3E/Inuse/$01/
  135.  $74/$57/
  136.  $2E/$8C/$16/DosSSeg/
  137.  $8C/$D6/
  138.  $8E/$C6/
  139.  $2E/$8E/$16/OurSSeg/
  140.  $2E/$8E/$1E/OurDseg/
  141.  $2E/$3B/$36/OurSSeg/
  142.  $89/$E6/
  143.  $74/$05/
  144.  $3E/$8B/$36/$74/$01/
  145.  $87/$F4/
  146.  $2E/$FF/$76/$00/
  147.  $2E/$FF/$76/$02/
  148.  $2E/$FF/$76/$04/
  149.  $2E/$FF/$76/$06/
  150.  $2E/$FF/$76/$0A/
  151.  $2E/$FF/$76/$0C/
  152.  $2E/$FF/$76/$0E/
  153.  $2E/$FF/$76/$10/
  154.  $B9/>$0028/
  155.  $26/$FF/$34/
  156.  $46/$46/
  157.  $E2/$F9/
  158.  $2E/$8E/$16/OurSSeg/
  159.  $56/
  160.  $2E/$8C/$5E/$0E/
  161.  $FB
  162.  ) ;
  163.  Intr (User_Int, Regs);
  164.  If (Halfregs.Ah = Quit_Key) then
  165.  stay_xit
  166.  else
  167.  If (Halfregs.Ah = Our_Char)
  168.  then if (not InUse) then
  169.  Begin
  170.  InUse := true;
  171. (*============================ Begin User Code =============================*)
  172. (*
  173.    Port[CrtAdapter+4] := (VideoMode - VideoEnable);   { Disable video }
  174. *)
  175.    If CrtMode = 7 then
  176.       Video_Buffer := $B000
  177.    else
  178.       Video_Buffer := $B800;
  179.    if ExtDot <> 0 then
  180.     begin {Original Code to Make/Append}
  181.      Assign(FileOut,NameOut);
  182.      If Exist(NameOut) then
  183.      begin
  184.         Append(FileOut);
  185.         FillChar(LineOut,80,'-');
  186.         LineOut[0] := Chr(80);
  187.         WriteLn(FileOut,LineOut);
  188.      end
  189.      else
  190.         ReWrite(FileOut);
  191.     end   {Original Code to Make/Append}
  192.     else
  193.      begin
  194.       ExtNum:=Succ(ExtNum);
  195.       if ExtNum>999 then ExtNum:=1;
  196.       Str(ExtNum:3,ExtChr);
  197.       for RIx:=1 to 3 do if ExtChr[RIx] = ' ' then ExtChr[RIx]:='0';
  198.       ExtNam:=NameOut+'.'+ExtChr;
  199.       Assign(FileOut,ExtNam);
  200.       ReWrite(FileOut);
  201.      end;
  202.    For RIx := 1 to 25 do
  203.    begin
  204.       NonSpace := 0;
  205.       For CIx := 1 to 80 do
  206.       begin
  207.          LineOut[CIx] := Chr(Mem[Video_Buffer: ((RIx-1)*160)+((CIx-1)*2)]);
  208.  
  209.          if Ord(LineOut[CIx]) > 128 then
  210.           begin
  211.            if not GphChr then LineOut[CIx]:= ' ';
  212.            if GphCon then
  213.             case Ord(LineOut[CIx]) of
  214.              196,205,
  215.              209,210,
  216.              193,202,
  217.              207,208,
  218.              194,203   : LineOut[CIx]:= '-';
  219.              218,201,
  220.              213,214,
  221.              191,187,
  222.              184,183   : LineOut[CIx]:= '.';
  223.              192,212,
  224.              200,211,
  225.              217,188,
  226.              190,189   : LineOut[CIx]:= ' ';
  227.              197,206,
  228.              216,215   : LineOut[CIx]:= '+';
  229.              179,186,
  230.              195,204,
  231.              198,199,
  232.              180,185,
  233.              181,182   : LineOut[CIx]:= ':';
  234.             else
  235.               LineOut[CIx]:= ' ';
  236.            end;
  237.           end;
  238.  
  239.          If LineOut[CIx] <> ' ' then
  240.             NonSpace := CIx;
  241.       end;
  242.       LineOut[0] := Chr(NonSpace);
  243.       WriteLn(FileOut,LineOut);
  244.    end;
  245.  
  246.    If CrtMode = 7 then
  247.       SaveScreen:=MonoScreen
  248.    else
  249.       SaveScreen:=CGAScreen;
  250.    RIx:=WhereY; CIx:=WhereX;
  251.    window(32,11,47,13);
  252.    ClrScr;
  253.    writeln('┌─────────────┐');
  254.    writeln('│    CLICK    │');
  255.    write  ('└─────────────┘');
  256.    Sound(5400);
  257.    Delay(200);
  258.    NoSound;
  259.  
  260.    If CrtMode = 7 then
  261.      MonoScreen:=SaveScreen
  262.     else
  263.      CGAScreen:=SaveScreen;
  264.    window(1,1,80,25);
  265.    GotoXY(CIx,RIx);
  266.    Close(FileOut);
  267. (*
  268.    Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  269. *)
  270.  
  271. (*============================= End User Code ==============================*)
  272.  Regs.Ax := $1D00;
  273.  InUse := false;
  274.  End;
  275.  inline(
  276.  $BD/Regs/
  277.  $2E/$8B/$46/$00/
  278.  $2E/$8B/$5E/$02/
  279.  $2E/$8B/$4E/$04/
  280.  $2E/$8B/$56/$06/
  281.  $2E/$8B/$76/$0A/
  282.  $2E/$8B/$7E/$0C/
  283.  $2E/$8E/$5E/$0E/
  284.  $2E/$8E/$46/$10/
  285.  $2E/$FF/$76/$12/
  286.  $9D/
  287.  $2E/$80/$3E/Inuse/$01/
  288.  $74/$23/
  289.  $FA /
  290.  $5E/
  291.  $B9/>$0028/
  292.  $2E/$8E/$06/DosSSeg/
  293.  $4E/$4E/
  294.  $26/$8F/$04/
  295.  $E2/$F9/
  296.  $89/$F5/
  297.  $07/
  298.  $1F/
  299.  $5F/
  300.  $5E/
  301.  $5A/
  302.  $59/
  303.  $5B/
  304.  $44/$44/
  305.  $89/$EC/
  306.  $2E/$8E/$16/DosSSeg/
  307.  $5D/
  308.  $BD/Regs/
  309.  $2E/$FF/$76/$12/
  310.  $9D/
  311.  $5D/
  312.  $FB/
  313.  $CA/$02/$00
  314.  );
  315. End;
  316. Begin
  317. (*=============================== User Code ================================*)
  318.    If ParamCount > 0 then
  319.       NameOut := ParamStr(1);
  320.  
  321.   GphChr:=false;
  322.   GphCon:=false;
  323.   ExtDot:= Pos('.',NameOut);
  324.   if ParamCount > 1 then
  325.    begin
  326.     if (ParamStr(2) = '/G') or (ParamStr(2) = '/g') then
  327.      GphChr:=true;
  328.     if (ParamStr(2) = '/C') or (ParamStr(2) = '/c') then
  329.      GphCon:=true;
  330.    end;
  331.  
  332. (*=============================== User Code ================================*)
  333.  InUse := false;
  334.  OurDseg:= Dseg;
  335.  OurSseg:= Sseg;
  336.  Terminate_Flag := false ;
  337.  SaveRegs.Ax := $35 shl 8 + User_Int;
  338.  Intr($21,SaveRegs);
  339.  if SaveRegs.Es <> $00 then
  340.  WriteLn ('Interrupt in use -- can''t install TDSnap as Resident Code')
  341.  else
  342.  begin
  343.  SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
  344.  Intr($21,SaveRegs);
  345.  SaveRegs.Ax := $25 shl 8 + User_Int;
  346.  SaveRegs.Ds := SaveRegs.Es;
  347.  SaveRegs.Dx := SaveRegs.Bx;
  348.  Intr($21,SaveRegs);
  349.  SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  350.  SaveRegs.Ds := Cseg;
  351.  SaveRegs.Dx := Ofs(Process_Intr);
  352.  Intr ($21,SaveRegs);
  353.  User_IntIp := MemW[0:User_Int * 4 ];
  354.  User_IntCs := MemW[0:User_Int * 4 +2];
  355. (*=============================== User Code ================================*)
  356.    TextColor(14);
  357.    TextBackGround(1);
  358.    ClrScr;
  359.    GotoXY(32,2);  Write('Saxman Software');
  360.    GotoXY(31,3);  Write('Tools Disk Series');
  361.    GotoXY(33,4);  Write('Program TDPRT');
  362.    TextColor(7);
  363.    WriteLn(''); WriteLn(''); WriteLn('');
  364.    Writeln('  TDSnap Memory Resident.');
  365.    WriteLn('  Press Ctrl-F10 to write snapshot to "',NameOut,'"');
  366.  
  367.    ExtNum:= 0;
  368.    if ExtDot = 0 then
  369.     WriteLn('  File Extension Will Auto-Increment.');
  370.    if GphCon then GphChr:=true;
  371.    Write('  Graphic Characters Are ');
  372.    if GphChr then writeln('Included.') else writeln('Suppressed.');
  373.    if GphCon then writeln('  Graphics Will Be Converted.');
  374.    WriteLn;
  375.    WriteLn('  Press Ctrl-Home to un-install.');
  376.  
  377. (*=============================== User Code ================================*)
  378.  SaveRegs.Ax := $31 shl 8 + 0 ;
  379.  SaveRegs.Dx := MemW [Cseg-1:0003] ;
  380.  Intr ($21,SaveRegs);
  381.  end;
  382. end.
  383.